home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: New Zealand Amiga Users Group / New Zealand Amiga Users Group Newsdisk v03 (1987-02)(NZAmigaUG).zip / New Zealand Amiga Users Group Newsdisk v03 (1987-02)(NZAmigaUG).adf / BASIC / RORv2 < prev    next >
Text File  |  1993-12-02  |  3KB  |  59 lines
  1. 10    ' ROR V2.01 mod'd by Garth Thornton
  2.      ' ( from v1.01 (c) 1985 Kevin A. Bjorke)
  3.       CLEAR ,60000&
  4.       ON ERROR GOTO 1000
  5.       ON BREAK GOSUB 1000
  6. 20    DIM map!(64,64),tile%(13000),shd(32):r!=0!:min!=0!:max!=0!:coff%=0:flag%=0:esc$=CHR$(27)
  7.       rin%=1:gin%=1:blin%=1:coff%=RND*30:cog%=RND*90:cob%=RND*61
  8. 30    DEF FNkr!(x!,y!)=x!/y!+r!*(RND-.5):DEF FNcolr!(p!)=INT((p!-min!)/range!)
  9.       FOR i=0 TO 31 STEP 2:shd(i)=i/32:shd(i+1)=shd(i):NEXT
  10. 40    SCREEN 1,320,200,5,1:WINDOW 2,,,,1:CLS:PRINT  "ROR V 2.01"
  11.       PRINT "Press escape to restart, 0 to EXIT":RANDOMIZE TIMER
  12. 50    PRINT :PRINT  "Hold on for a minute ...":GOSUB 140:GOSUB 250:CLS:GOSUB 300
  13. 60    a$=INKEY$:IF a$=esc$ THEN flag%=0:GOTO 50
  14.       IF a$="0" THEN GOTO 1000
  15. 70    GOSUB 520:GOTO 60
  16. 80    END
  17. 140   ' Build Topology
  18. 150   IF NOT (INKEY$="") GOTO 150 
  19.       FOR c%=6 TO 1 STEP -1:st%=2^c%:bk%=st%\2:r!=8!*2!^(c%-5)
  20. 170   FOR a%=bk% TO 64 STEP st%:a1%=a%-bk%:a2%=a%+bk%
  21. 180   FOR b%=bk% TO 64 STEP st%:b1%=b%-bk%:b2%=b%+bk%
  22. 190   map!(a%,b2%)=FNkr((map!(a1%,b2%)+map!(a2%,b2%)),2!)
  23. 200   map!(a2%,b%)=FNkr((map!(a2%,b1%)+map!(a2%,b2%)),2!)
  24. 210   IF a%=bk% THEN map!(0,b%)=FNkr((map!(0,b1%)+map!(0,b2%)),2!)
  25. 220   IF b%=bk% THEN map!(a%,0)=FNkr((map!(a1%,0)+map!(a2%,0)),2!)
  26. 230   map!(a%,b%)=FNkr((map!(a1%,b1%)+map!(a2%,b1%)+map!(a1%,b2%)+map!(a2%,b2%)),4!)
  27. 240   NEXT b%,a%,c%:RETURN
  28. 250   ' Calculate color set
  29. 260   min!=0!:max!=0!:FOR a%=0 TO 64:FOR b%=0 TO 64
  30. 270   IF map!(a%,b%)>max! THEN max!=map!(a%,b%) ELSE IF map!(a%,b%)<min! THEN min!=map!(a%,b%)
  31. 280   NEXT b%
  32. 290   NEXT a%:range!=(max!-min!)/31!:RETURN
  33. 300   ' Draw map
  34. 310   COLOR 31:LINE(127,63)-(257,193),,b
  35. 320   FOR a%=0 TO 64:reg%=FNcolr!(map!(a%,a%)):GOSUB 460
  36. 330   x%=a%+128:xx%=256-a%:y%=a%+64:yy%=192-a%:LINE (x%,y%)-(xx%,yy%),,b
  37. 340   IF a%=64 THEN 400
  38. 350   FOR b%=a%+1 TO 64
  39. 360   reg%=FNcolr!(map!(a%,b%)):GOSUB 460:LINE (x%,b%+64)-(xx%,192-b%),,b
  40. 370   reg%=FNcolr!(map!(b%,a%)):GOSUB 460:LINE (b%+128,y%)-(256-b%,yy%),,b
  41. 390   NEXT b%
  42. 400   NEXT a%: GET (128,64)-(256,192),tile%:IF NOT flag% THEN GOSUB 430
  43. 410   RETURN
  44. 420   '
  45. 430   CLS:FOR a%=0 TO 256 STEP 128:FOR b%=0 TO 128 STEP 128
  46. 440   PUT (a%,b%),tile%:NEXT b%,a%:flag%=-1:RETURN
  47. 450   '
  48. 460   IF reg%>31 THEN reg%=31
  49. 470   COLOR reg%:RETURN
  50. 520   ' Cycle colors
  51.       FOR i%=0 TO 60:NEXT
  52.       coff%=coff%+rin%:IF coff%=0 OR coff%=31 THEN rin%=-rin%
  53.       cog%=cog%+gin%:IF  cog%=92 THEN cog%=0
  54.       cob%=cob%+blin%:IF cob%=0 OR cob%=63 THEN blin%=-blin% 
  55. 540   FOR reg%=0 TO 31:r=(reg%+coff%) AND 31:green=(reg%+cog%\3) AND 31:blue=(reg%+cob%\2) AND 31
  56. 550   PALETTE reg%,shd(r),shd(green),shd(blue):NEXT reg%:RETURN
  57. 1000  SCREEN CLOSE 1
  58. 1010  STOP
  59.